home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / efs / efs-fnh.el.z / efs-fnh.el
Encoding:
Text File  |  1998-05-21  |  4.8 KB  |  157 lines
  1. ;; -*-Emacs-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;
  4. ;; File:         efs-fnh.el
  5. ;; Release:      $efs release: 1.15 $
  6. ;; Version:      #Revision: 1.3 $
  7. ;; RCS:
  8. ;; Description:  Look for the emacs version, and install into
  9. ;;               the file-name-handler-alist
  10. ;; Author:       Sandy Rutherford <sandy@ibm550.sissa.it>
  11. ;;
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13.  
  14. ;;; Although used by efs, these utilities could be of general use to other
  15. ;;; packages too. Keeping them separate from the main efs program
  16. ;;; makes it easier for other programs to require them.
  17.  
  18. (provide 'efs-fnh)
  19.  
  20. (defconst efs-fnh-version
  21.   (concat (substring "$efs release: 1.15 $" 14 -2)
  22.       "/"
  23.       (substring "#Revision: 1.3 $" 11 -2)))
  24.  
  25. ;;;###autoload
  26. (defvar allow-remote-paths t
  27.    "*Set this to nil if you don't want remote paths to access
  28. remote files.")
  29.  
  30. ;;;; ----------------------------------------------------------------
  31. ;;;; Loading emacs version files
  32. ;;;; ----------------------------------------------------------------
  33.  
  34. (defun efs-handle-emacs-version ()
  35.   ;; Load appropriate files for the current emacs version
  36.   (let ((ehev-match-data (match-data)))
  37.     (unwind-protect
  38.     (let ((lucidp (string-match "Lucid" emacs-version))
  39.           ver subver)
  40.       (or (string-match "^\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version)
  41.           (error "efs does not work with emacs version %s" emacs-version))
  42.       (setq ver (string-to-int (substring emacs-version
  43.                           (match-beginning 1)
  44.                           (match-end 1)))
  45.         subver (string-to-int (substring emacs-version
  46.                          (match-beginning 2)
  47.                          (match-end 2))))
  48.       (cond
  49.        
  50.        ;; Lucid XEmacs (emacs-version looks like \"19.xx XEmacs Lucid\")
  51.        (lucidp
  52.         (cond
  53.          ((and (= ver 19) (>= subver 11) (< subver 15))
  54.           (require 'efs-l19\.11))
  55.          ((and (= ver 19) (>= subver 15))
  56.           (require 'efs-x19\.15))
  57.          ((= ver 20)
  58.           (require 'efs-x19\.15))
  59.          (t
  60.           (error
  61.            "efs does not work with emacs version %s" emacs-version))))
  62.  
  63.        ;; Original GNU Emacs from FSF
  64.        (t
  65.         (cond
  66.          ((and (= ver 19) (<= subver 22))
  67.           (require 'efs-19))
  68.          ((and (= ver 19) (>= subver 23))
  69.           (require 'efs-19\.23))
  70.          
  71.          ;; GNU Emacs 18-
  72.          ((<= ver 18)
  73.           (require 'efs-18)) ; this file will (require 'emacs-19)
  74.  
  75.          (t
  76.           (error
  77.            "efs does not work with emacs version %s" emacs-version))))))
  78.       
  79.       (store-match-data ehev-match-data))))
  80.  
  81. ;;;; --------------------------------------------------------------
  82. ;;;; Stuff for file name handlers.
  83. ;;;; --------------------------------------------------------------
  84.  
  85. ;;; Need to do this now, to make sure that the file-name-handler-alist is
  86. ;;; defined for Emacs 18.
  87.  
  88. (efs-handle-emacs-version)
  89.  
  90. ;; Also defined in efs-cu.el
  91. (defvar efs-path-root-regexp "^/[^/:]+:"
  92.   "Regexp to match the `/user@host:' root of an efs full path.")
  93.  
  94. (defun efs-file-name-handler-alist-sans-fn (fn)
  95.   ;; Returns a version of file-name-handler-alist without efs.
  96.   (delq nil (mapcar
  97.          (function
  98.           (lambda (x)
  99.         (and (not (eq (cdr x) fn)) x)))
  100.          file-name-handler-alist)))
  101.  
  102. (defun efs-root-handler-function (operation &rest args)
  103.   "Function to handle completion in the root directory."
  104.   (let ((handler (and (if (boundp 'allow-remote-paths)
  105.               allow-remote-paths
  106.             t)
  107.               (get operation 'efs-root))))
  108.     (if handler
  109.     (apply handler args)
  110.       (let ((inhibit-file-name-handlers
  111.          (cons 'efs-root-handler-function
  112.            (and (eq inhibit-file-name-operation operation)
  113.             inhibit-file-name-handlers)))
  114.         (inhibit-file-name-operation operation))
  115.     (apply operation args)))))
  116.  
  117. (put 'file-name-completion 'efs-root 'efs-root-file-name-completion)
  118. (put 'file-name-all-completions 'efs-root 'efs-root-file-name-all-completions)
  119. (autoload 'efs-root-file-name-all-completions "efs-netrc")
  120. (autoload 'efs-root-file-name-completion "efs-netrc")
  121.  
  122. (autoload 'efs-file-handler-function "efs"
  123.       "Function to use efs to handle remote files.")
  124.  
  125. ;; Install into the file-name-handler-alist.
  126. ;; If we are already there, remove the old entry, and re-install.
  127. ;; Remove the ange-ftp entry too.
  128.  
  129. (setq file-name-handler-alist
  130.       (let (dired-entry alist)
  131.     (setq alist
  132.           (nconc
  133.            (list
  134.         (cons efs-path-root-regexp 'efs-file-handler-function)
  135.         '("^/$" . efs-root-handler-function))
  136.            (delq nil
  137.              (mapcar
  138.               (function
  139.                (lambda (x)
  140.              (if (eq (cdr x) 'dired-handler-fn)
  141.                  (progn
  142.                    (setq dired-entry x)
  143.                    nil)
  144.                (and (not
  145.                  (memq (cdr x)
  146.                        '(remote-path-file-handler-function
  147.                      efs-file-handler-function
  148.                      efs-root-handler-function
  149.                      ange-ftp-hook-function
  150.                      ange-ftp-completion-hook-function)))
  151.                 x))))
  152.               file-name-handler-alist))))
  153.     ;; Make sure that dired is in first.
  154.     (if dired-entry (cons dired-entry alist) alist)))
  155.  
  156. ;;; end of efs-fnh.el
  157.